// plugin.cpp : Defines the entry point for the Programmer's Notepad Plugin
//

// if PERL_DL is defined, we will use a dynamically loaded perl; perl_dl.c
//   must be compiled and then included when compiling this file
// otherwise, the perl library file must be included when compiling this file

// if NEED_XS is defined, the embedded perl will have access to XS modules
// otherwise it will not

#include "stdafx.h"
#include "plugin.h"
#include "utils.h"
	
#ifdef NEED_XS
	#define XS_INIT xs_init
	#include "perlxsi.c"
#else
	#define XS_INIT NULL
#endif

#define PERL_ARGV_MAX 0xff
int g_PerlArgc;
char* g_PerlArgv[PERL_ARGV_MAX];

char g_HelpFilePath[MAX_PATH];

#include "XS/perl_classes.h"

#ifdef PERL_DL

char* get_perl_dll();
void menu_get_dll(extensions::cookie_t /*cookie*/);

#endif

// defined in "XS/PlPN.cpp"
extern "C" void boot_PlPN(pTHX_ CV* cv);
extern "C" void* get_app_event_sink();

BOOL APIENTRY DllMain( HMODULE hModule,
                       DWORD  ul_reason_for_call,
                       LPVOID lpReserved
					 ) {
    return TRUE;
}

bool __stdcall pn_init_extension(int iface_version, extensions::IPN* pn) {
	if (iface_version != PN_EXT_IFACE_VERSION) {
		alert("Plugin was compiled with interface version %d, program was compiled with interface version %d", PN_EXT_IFACE_VERSION, iface_version);
		return false;
	}
	
	char szProgram[MAX_PATH];
	char szPnPath[MAX_PATH];
	char szScript[MAX_PATH];
	
	extensions::IOptions* opts = pn->GetOptionsManager();

	const wchar_t* szPnPathWide = opts->GetPNPath();
	
	if(!GetModuleFileName(NULL, szProgram, MAX_PATH)) {
		alert("Cannot get executable file name (%d)\n", GetLastError());
		return false;
	}
	
	if (wcstombs(szPnPath, szPnPathWide, MAX_PATH) == -1) {
		alert((char*)"Unable to convert PN Path");
	}
	
	pn->ReleaseString(szPnPathWide);
	
	strcpy(szScript, szPnPath);
	::PathAppend(szScript, "PlPN.pm");

	strcpy(g_HelpFilePath, szPnPath);
	::PathAppend(g_HelpFilePath, "PlPN.chm");
	
	size_t length;
	g_PerlArgc = 2;

	length = strlen(szProgram);
	g_PerlArgv[0] = (char*)malloc(length+1);
	strcpy(g_PerlArgv[0], szProgram);

	length = strlen(szScript);
	g_PerlArgv[1] = (char*)malloc(length+1);
	strcpy(g_PerlArgv[1], szScript);

	// my_pn needs to be set before init_perl is called
	my_pn = pn;
	
	if (! init_perl(&g_PerlArgc, (char ***)&g_PerlArgv)) {
		alert("Perl failed to initialise");
	}
	
	Menu submenu = Menu();

	// menu items to add the interpreter
	extensions::tagMenuItem cycle_item;
	cycle_item.Type = extensions::miItem;
	cycle_item.Title = L"Cycle Perl Interpreter";
	cycle_item.UserData = 0;
	cycle_item.Handler = menu_cycle_interpreter;
	submenu.AddItem(cycle_item);

#ifdef PERL_DL

	extensions::tagMenuItem dll_item;
	dll_item.Type = extensions::miItem;
	dll_item.Title = L"Select Perl DLL";
	dll_item.UserData = 0;
	dll_item.Handler = menu_get_dll;
	submenu.AddItem(dll_item);

#endif
	
	extensions::tagMenuItem help_item;
	help_item.Type = extensions::miItem;
	help_item.Title = L"Help";
	help_item.UserData = 0;
	help_item.Handler = menu_show_help;
	submenu.AddItem(help_item);
	
	Menu menu = Menu();
	extensions::tagMenuItem submenu_item;
	submenu_item.Type = extensions::miSubmenu;
	submenu_item.Title = L"PlPN";
	submenu_item.UserData = 0;
	submenu_item.SubItems = &submenu;
	menu.AddItem(submenu_item); 
	
    pn->AddPluginMenuItems(&menu);

	pn->AddEventSink(*(extensions::IAppEventSinkPtr*)get_app_event_sink());
	
	if (! create_interpreter(g_PerlArgc, g_PerlArgv)) {
		alert("Unable to create a Perl interpreter");
	}
	
	return true;
}

void __declspec(dllexport) __stdcall pn_get_extension_info(PN::BaseString& name, PN::BaseString& version) {
	name = PlPN_Plugin_Name;
	version = PlPN_Plugin_Version;
}

void __declspec(dllexport) __stdcall pn_exit_extension() {
	for (int i = 0; i < g_PerlArgc; i++) {
		free((void*)g_PerlArgv[i]);
	}

	if (! destroy_interpreter()) {
		alert("Unable to destroy the Perl interpreter");
		return;
	}
	
	if (! term_perl()) {
		alert("Perl failed to terminate");
		return;
	}
}

/*

interpreter functions

*/

#ifdef PERL_DL

char* get_perl_dll() {
	char* possible[] = {
		"perl",
		"perl5",
		"perl58",
		"perl510",
		"perl512",
		"perl514",
		"perl516",
		"perl518",
		"perl520",
		NULL
	};
	char* found = (char*)malloc(MAX_PATH);
	memcpy((void*)found, (void*)"\0", 1);	// default to empty string

	int i = 0;
	while (possible[i] != NULL) {
		HMODULE pm = LoadLibrary(possible[i]);
		if (pm != NULL) {
			FreeLibrary(pm);
			strcpy(found,possible[i]);
			return found;
		}
		i++;
	}
	// if we get here, none of them worked; ask the user
	wchar_t* wide_dll = my_pn->InputBox(L"Perl DLL",
		L"PlPN was unable to find your Perl DLL. Please enter it below."
	);
	if (wide_dll != NULL) {
		char* user_said = wide_2_utf8(wide_dll);
		my_pn->ReleaseString(wide_dll);
		strcpy(found, user_said);
		free((void*)user_said);
	}
	return found;
}

#endif

BOOL init_perl(int* argc, char*** argv) {
#ifdef PERL_DL
/*

For testing - just use 512

*/

	// get the value from the options manager
	wchar_t* wide_perldll = my_pn->GetOptionsManager()->GetS(L"PlPN", L"perldll", L"perl");
	char* perldll = wide_2_utf8(wide_perldll);
	my_pn->ReleaseString(wide_perldll);

	int number_loaded = 0;
	if (! load_perl(perldll, &number_loaded)) {
		free((void*)perldll);
		// the one from the options manager (or the default "perl") didn't work
		// so make a few guesses
		perldll = get_perl_dll();
		if (load_perl(perldll, &number_loaded)) {
			// sucessful load; save this value for next time
			wide_perldll = utf8_2_wide(perldll);
			my_pn->GetOptionsManager()->Set(L"PlPN", L"perldll", wide_perldll);
			free((void*)wide_perldll);
		}
		else {
			// still didn't work; just give up
			alert("Perl failed to load");
			free((void*)perldll);
			return FALSE;
		}
	}
	free((void*)perldll);
#endif

	PERL_SYS_INIT3(argc, argv, (char ***)NULL);
	return TRUE;
}

BOOL term_perl() {
	PERL_SYS_TERM();
#ifdef PERL_DL
	if (! unload_perl()) {
		alert("Perl failed to unload");
		return FALSE;
	}
#endif
	return TRUE;
}

BOOL create_interpreter(int argc, char** argv) {
	my_perl = perl_alloc();
	if (my_perl == NULL) {
		alert("perl_alloc failed");
		return FALSE;
	}

	// this doesn't work if we include "XSUB.h"
	// (although we might be able to fix it)
	//PL_perl_destruct_level = 1;
	// this works either way
	my_perl->Iperl_destruct_level = 1;

	perl_construct(my_perl);
	// void return; nothing to check

	// this doesn't work if we include "XSUB.h"
	// (although we might be able to fix it)
	//PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
	// this works either way
	my_perl->Iexit_flags |= PERL_EXIT_DESTRUCT_END;

	int ret = perl_parse(my_perl, XS_INIT, argc, argv, (char **)NULL);
	if (ret != 0) {
		alert("perl_parse failed on %s : %s; returned %d", argv[0], argv[1], ret);
		return FALSE;
	}
	
	CV* bootstrap = newXS("PlPN::bootstrap", boot_PlPN, __FILE__);
	if (bootstrap == NULL) {
		alert("newXS(\"PlPN::bootstrap\" failed");
		return FALSE;
	}
	
	perl_run(my_perl);
	// if perl_parse succeeded, return value doesn't matter to us
	// but $@ does, because we might still have run-time errors
	if(SvTRUE(ERRSV)) {
		STRLEN n_a;
		alert("runtime error: %s\n", SvPV(ERRSV,n_a));
	}
	
	// get the .pm file and convert \ to /
	char pm_file[MAX_PATH];
	strcpy(pm_file, g_PerlArgv[1]);
	char* bs = pm_file;
	while(bs = strchr(bs,'\\')) {
		bs[0] = '/';
		bs++;
	}
	// put the converted .pm in %INC so it doesn't get read again
	hv_store(
		get_hv("INC", 0),	/* target; 0 means Perl will not create (%INC is automatic) */
		"PlPN.pm",							/* key */
		7,									/* key length */
		sv_2mortal(newSVpv(pm_file, 0)),	/* value; 0 means Perl will compute length */
		0									/* hash; 0 means let perl compute */
	);

	char *args[] = { NULL };
	call_argv("PlPN::init", G_DISCARD | G_EVAL, args);
	// returns number of values returned by the perl sub; doesn't matter to us
	if(SvTRUE(ERRSV)) {
		STRLEN n_a;
		alert("init error: %s\n", SvPV(ERRSV,n_a));
	}

	return TRUE;
}

BOOL destroy_interpreter() {
	// this doesn't work if we include "XSUB.h"
	//PL_perl_destruct_level = 1;
	// this works either way
	my_perl->Iperl_destruct_level = 1;

	int ret = perl_destruct(my_perl);
	if (ret != 0) {
		alert("perl_destruct failed; returned %d", ret);
		//return FALSE;
		// go ahead and free it anyway
	}
	
	perl_free(my_perl);
	// void return; nothing to check

	return TRUE;
}

BOOL cycle_interpreter(int argc, char** argv) {
	SV* object = get_sv("PlPN::PlPN", 1);	// 1 means Perl will create if it doesn't exist

	dSP;
		
	ENTER;
	SAVETMPS;

	PUSHMARK(SP);
	XPUSHs(object);
	PUTBACK;
		
	call_method("OnBeforeCycle", G_VOID|G_EVAL);
	SPAGAIN;

	if(SvTRUE(ERRSV)) {
		STRLEN n_a;
		alert("Error calling OnBeforeCycle: %s\n", SvPV(ERRSV,n_a));
	}

	PUTBACK;
	FREETMPS;
	LEAVE;

	if (! destroy_interpreter()) {
		alert("Unable to destroy the Perl interpreter");
		return FALSE;
	}

	if (! create_interpreter(argc, argv)) {
		alert("Unable to recreate the Perl interpreter");
		return FALSE;
	}

	// cycling will have invalidated our object and our stack pointer
	// so get them again
	object = get_sv("PlPN::PlPN", 1);	// 1 means Perl will create if it doesn't exist
	SPAGAIN;
		
	ENTER;
	SAVETMPS;

	PUSHMARK(SP);
	XPUSHs(object);
	PUTBACK;
		
	call_method("OnAfterCycle", G_VOID|G_EVAL);
	SPAGAIN;

	if(SvTRUE(ERRSV)) {
		STRLEN n_a;
		alert("Error calling OnAfterCycle: %s\n", SvPV(ERRSV,n_a));
	}

	PUTBACK;
	FREETMPS;
	LEAVE;

	return TRUE;
}

void run_script(char* filename) {
	char *args[] = { filename, NULL };
	
	call_argv("PlPN::eval_file", G_DISCARD | G_EVAL, args);
	// returns number of values returned by the perl sub; doesn't matter to us
	
	if(SvTRUE(ERRSV)) {
		STRLEN n_a;
		alert("runtime error: %s\n", SvPV(ERRSV,n_a));
	}

	return;
}

/*

menu functions

*/

void menu_cycle_interpreter(extensions::cookie_t /*cookie*/) {
	if (! cycle_interpreter(g_PerlArgc, g_PerlArgv)) {
		alert("Unable to cycle interpreter");
	}
}

#ifdef PERL_DL

void menu_get_dll(extensions::cookie_t /*cookie*/) {
	wchar_t* user_said = my_pn->InputBox(L"Perl DLL",
		L"Enter the new DLL below.\n\n"
		L"(It will not take effect until PN is restarted.)"
	);
	if (user_said != NULL) {
		my_pn->GetOptionsManager()->Set(L"PlPN", L"perldll", user_said);
		my_pn->ReleaseString(user_said);
	}
	return;
}

void menu_show_help(extensions::cookie_t /*cookie*/) {
	HtmlHelp(
		NULL,	// Passing NULL as the caller causes HtmlHelp to load in sibling mode
		g_HelpFilePath,
		HH_DISPLAY_TOC,
		NULL
	);
	return;
}

#endif

/*

hacks

*/

extensions::IPN* get_my_pn() { return my_pn; }
PerlInterpreter* get_my_perl() { return my_perl; }
